\ Install - PowerMops version.

\ Dec 97		Initial version.

\ need	window+

\ konst resLocked		constant	LOCKED
\ konst resPurgeable	constant	PURGEABLE

syscall HCreateResFile
syscall CloseResFile
syscall HOpenResFile


    0	value		CURSTACK
    0	value		CURDICT

    0	value		HEAPAVAIL
false	value		GOTFREE?
true	value		SAVE?

    0	value		QUITWORD
    0	value		ABORTWORD

	string		$TMP

	int		APREFNUM
	var		APPARAM

23	dialog		IDLG


: NOGO	3 beep  3 beep  close: iDlg  set: fWind
	cr ." Res error# " .
	cr ." Type any key to return to Finder, hopefully"
	key  bye  ;



\ : !STACK	curStack -> stkSpace  ;

\ : @HEAP		\ Returns starting heap size for this nucleus.
\	gotFree?  NIF  free  -> heapAvail  true -> gotFree?  THEN
\	heapAvail  ;

\ : CURHEAP		\ Computes amount of heap available for current configuration.
\	@heap  stkspace curStack - +  room curDict - +  ;

\ : SETMEM		\ Sets nucleus stack to selected values
\	!stack
\	curDict -> maxdic  ;

: iMsg		\ ( addr1 len1 addr2 len2 -- )  Gives informatory message
	"  " "  " ParamText draw: iDlg  ;

: ChR		\ ( handle -- handle )  Marks the resource for update to disk
	dup ChangedResource  ;


: INVWORD		\ ( item# -- )
	40 beep  0  $ ffff rot  setSelect: iDlg  ReturnToModal  ;

: OK		\ Validates quits & abort words; if bad returns to modal
	23 getItem: iDlg
	NIF			\ not shared library - check start word
		10 getText: iDlg  sFind  NIF  10 invWord  EXIT  THEN
		-> quitword
	THEN
	11 getText: iDlg  sFind  NIF  11 invWord  EXIT  THEN
	-> abortword
	true  ;

: CANCEL	false  ;

: sharedLibItem
	togitem
	23 getitem: iDlg
	IF		3 hideitem: iDlg  15 hideitem: iDlg
			10 hideitem: iDlg  19 hideitem: iDlg
	ELSE	3 showitem: iDlg  15 showitem: iDlg
			10 showitem: iDlg  19 showitem: iDlg
	THEN
;

xts{	ok cancel null null null null null null null null null
		togitem togItem togItem null null null null null null null
		togitem sharedLibItem  }
	111  init: iDlg   1  setBold: iDlg

: GETR
	get_appl_name ->: $tmp  all: $tmp  5  putText: iDlg
	get_appl_vers ->: $tmp  all: $tmp  4  putText: iDlg
	get_appl_sig  pad !  pad 4  3  putText: iDlg  ;

: DROP@		\ ( addr len -- addr' )
		\ Fetches 1st four bytes on an odd byte, pad with blanks
	>r sp@ $ 20202020 rot rot r> 4 min cmove  ;

: SETFREF		\ ( type n -- )
	'type FREF  swap  set: srcRes  getNew: srcRes
	get: srcRes  ChR  >ptr !  ;



scon	$ALQ	"alert%"	& %  & "  instead

0		value	currVref


: NEW_APPLICATION  { \ sig addr len fRefNum -- }
		\ This word does all the hard work of creating the
		\ installed application file.  For PowerMops, it's a glorified
		\ version of SAVEDIC in zFEmod.

	5 getText: iDlg  -> len -> addr

	23 getItem: iDlg
	IF							\ it's a shared library
		true -> shared_lib?
		" Save shared library as:"
	ELSE
		" Save installed application as:"
	THEN
	addr len
	stdPut: fFcb  0EXIT					\ out if user cancelled

	getVref: fFcb  -> currVref
	getName: fFcb  -> len  -> addr		\ name may have changed

\ now we can't just use  create: ffcb, since that method just opens the
\  file if it already exists, and when we try to write the resources we'll
\  get an error since they're there already.  We have to actually delete
\  the file in this situation.

	open: ffcb
	NIF			\ no error - i.e. it exists
		close: ffcb drop
		delete: ffcb  OK?
	THEN

	create: ffcb  OK?
	shared_lib?
	IF
		'type cfmg  -> sig
		'type shlb
	ELSE
		3  getText: iDlg  drop@ -> sig		\ New sig
		'type APPL
	THEN
	sig  set: ffcb						\ Set type & sig of appl
	$ 21  addr: ffcb $ 28 + c!			\ Set Bundle bit
	setFileInfo: ffcb  OK?

	currVRef  0  addr len str255  HCreateResFile  drop resChk
	currVref  0  buf255  0  HOpenResFile  -> fRefNum  resChk

\ now the res fork should be still open, so we add the other resources:

	13 getitem: iDlg
	IF	true -> fWind?					\ fWind? wanted - copy it (WIND 256)
		'type WIND  256  copyRes
		12 getitem: iDlg  8 <<  ptr: dstRes 10 + w!
										\ Mark visible or not
	ELSE
		false -> fWind?
	THEN

	'type BNDL  129  copyRes			\ and don't drop our BNDL (129)
	sig  ptr: dstRes  !					\ Store in new BNDL
	
\ Now set up FREFs:

	'type FREF  128  copyRes			\ FREF for APPL - doesn't change
	10 6 DO								\ FREFs 129 onwards
		i getText: iDlg  dup
		NIF  drop  LEAVE  THEN
		'type FREF  123 i +  copyRes
		drop@  ptr: dstRes  !
	LOOP
	
\ Now we create the new version resource which has a "type" that is the
\ same as the sig, and ID 0.

	sig  0  set: dstRes
	4 getText: iDlg  dup 1+ align  new: dstRes
	str255  ptr: dstRes  over  c@ 1+ cMove
	nullOSstr  addRes: dstRes
	
\ Now copy the Alert" stuff if we need it

	$alq sfind nip
	IF	'type ALRT  900  copyRes
		'type DITL  900  copyRes
	THEN

	quitword -> quitVec		\ startup word
	abortword -> abortVec	\ error word

	true  true  (wp)		\ true = res fork open, true = installing
	
	fRefNum  CloseResFile
	close: ffcb  drop
	bye						\ we don't try to keep running since we've
;							\  changed vectors.  We could, but it's not
							\  worth the bother, and anyway we don't do
							\  it in the 68k version.


: INSTALLWIND
	openMR
	getnew: iDlg   getR
	21 hideItem: iDlg				\ PowerMops doesn't use this one
	" go"	 10 putText: iDlg
	" crash" 11 putText: iDlg
	0 $ ffff 3 setSelect: iDlg
	arrowCurs
	modal: iDlg
	IF	new_application  THEN		\ will quit unless they cancel
	close: iDlg
;